COMMENT ⊗   VALID 00010 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGOF("CTRLC")
C00003 00003	PUBLIC SIMPLE PROCEDURE CTRLC! $"#
C00005 00004	PUBLIC SIMPLE PROCEDURE DSNEAK $"#
C00007 00005	PUBLIC SIMPLE PROCEDURE DTURN(BOOLEAN TURNON) $"#
C00009 00006	PRIVATE SIMPLE BOOLEAN PROCEDURE ENDOFSEGMENT $"#
C00010 00007	PRIVATE INTEGER PROCEDURE FIND!CHR(INTEGER CHR) $"#
C00011 00008	PUBLIC RECURSIVE PROCEDURE SCANTEXT $"#
C00023 00009	PUBLIC SIMPLE PROCEDURE TURN(INTEGER CHR,FUN,ONOFF) $"#
C00026 00010	FINISHED
C00027 ENDMK
C⊗;
BEGOF("CTRLC")
COMMENT

Control characters are detected by the break table of SCAN. TURN
ON/OFF attempt to keep that break table current.  Outer block control
characters that have been redefined are stacked on ISTK in TURNTYPE
records.

;
PROCEDURES
PUBLIC SIMPLE PROCEDURE CTRLC! ;$"#
BEGIN "CTRLC!"
INTEGER J ;
STRING S ;
J ← 0 ;
PJ 5/27/74 ITS does not like <control-C>'s;
FOR S ← CR, ALTMODE&"{", RUBOUT, "α", 3, "#", "\", "∂", "←", "→", "∞",
	"↑", "↓", "]", "-", ".!?", SP, "_", "π", "∪", "∩", VT, "$", "%",
	"⊗", "[", "&" DO
		COMMENT 2D CHARS OF DIPHTHONGS COME NOT BEFORE [ IN LIST ↑ ;
		BEGIN J←J+1; WHILE FULSTR(S) DO DPB(J, SPCHAR(LOP(S))) ; END ;
AMSAND ← J ; LBRACK ← J-1 ; UNDERBAR ← 18 ; UARROW ← 12 ; DARROW ← 13 ;
LCURLY ← 2 ; DOLLAR ← 23 ; XCMDCHR ← 25 ;
FOR S ← SP, TB, FF, VT, CR, LF, 0 DO CHARTBL[S] ← CHARTBL[S] LOR TWO(6) ;
CHARSP ← CR & ALTMODE & RUBOUT & "α"&3&"#\∂←→∞↑↓]-? _π∪∩" & VT & "$%⊗[&" ;
END "CTRLC!" ;
PUBLIC SIMPLE PROCEDURE DSNEAK ;$"#
BEGIN "DSNEAK" TES 11/4/74 ;
STRING PIECE ;
BOOLEAN SPECIAL ;
SPECIAL ← FALSE ;
PASS ;
IFC PARCVER THENC
IF ITSV(PARCMNEMONIC) THEN
	BEGIN
	PASS ;
	SPECIAL ← TRUE ;
	IF ABS(DEVICE) NEQ MIC THEN BEGIN E(NULL,NULL); RETURN END ; TES 11/17/74;
	END ;
ENDC
RKJ: 6-FEB-75 NEW DEFINITION OF SNEAK BETWEEN PGPHS
   DELETED: IF NOPGPH THEN PGPHSTART ;
PIECE ← MASH(E(NULL, NULL)) ;
IF SPECIAL THEN PIECE ← 63&PIECE ;
IF ON THEN
	BEGIN
			COMMENT TES 1/12/75 CVSR: ;
	PIECE←FONTCHAR & "π" & CVSR(LENGTH(PIECE)) & PIECE ;
	IF NOPGPH THEN  RKJ: 6-FEB-75 ;
	    BEGIN SNEAKLINE(FONTCHAR & "S" & PIECE); RETURN END ;
	EMITPIECE(PIECE, 0, 0) ;
	SNUCK ← TRUE ; TES 11/17/74 ;
	IF VERBATIM THEN DBREAK ; TES 11/17/74;
	END ;
END "DSNEAK" ;
PUBLIC SIMPLE PROCEDURE DTURN(BOOLEAN TURNON) ;$"#
BEGIN
comment TURN ON|OFF {"c" [FOR "c"]},... ;
INTEGER C1, C2 ; STRING S1, S2 ;
PASS ;
IF THISTYPE>INTERNTYPE OR THISTYPE=-TERQ OR NEXTSCH(:) OR NEXTSCH(←) THEN
	BEGIN "TURN BACK"
	IF ON THEN TES 9/23/74 ;
		BEGIN
		C1 ← IHED ;
		WHILE C1>0 AND (C2←IXTYPE(C1)) NEQ MODETYPE AND (C2 NEQ TURNTYPE OR ISTK[C1-1]<0) DO
			C1 ← IXOLD(C1) ;
		IF C2=TURNTYPE THEN DO
			BEGIN
			TURN((C2←ISTK[C1-1]) LSH -7,C2 LAND '177,1) ;
			ISTK[C1-1] ← -2 ;
			C1 ← IXOLD(C1) ;
			END
		UNTIL C1 LEQ 0 OR IXTYPE(C1) NEQ TURNTYPE OR ISTK[C1-1]<0 ;
		END ;
	END "TURN BACK"
ELSE	BEGIN "TURN CHARS"
	IF ON THEN TES 9/23/74 ;
		BEGIN
		PUSHI(TURNWDS, TURNTYPE) ;
		ISTK[IHED-1] ← -1 ;
		END ;
	DO BEGIN
	IF ITSCH(<,>) THEN PASS ;
	S1 ← IF NOT ITS(TAB) THEN SIMPAR ELSE TB ; PASS ;
		COMMENT 2/27/73 TES ;
	IF ITS(FOR) THEN
		BEGIN
		PASS ;
		S2 ← SIMPAR ;
		PASS ;
		END
	ELSE IF TURNON THEN S2 ← S1
	ELSE S2 ← NULL ;
	IF ON THEN
		BEGIN
		IF 0 NEQ LENGTH(S2) NEQ LENGTH(S1) THEN
			WARN(NULL,"Strings each side of FOR are unequal length") ;
		WHILE FULSTR(S1) DO
		  TURN(LOP(S1), IF FULSTR(S2) THEN LOP(S2) ELSE 0, TURNON) ;
		END ;
	END	UNTIL  NOT ITSCH(<,>) ;
	END "TURN CHARS" ;
END "DTURN" ;
PRIVATE SIMPLE BOOLEAN PROCEDURE ENDOFSEGMENT ;$"#
	RETURN(NULSTR(INPUTSTR) OR INPUTSTR=CR OR LDB(SPCODE(INPUTSTR))=LCURLY) ;
PRIVATE INTEGER PROCEDURE FIND!CHR(INTEGER CHR) ;$"#
	BEGIN "FIND!CHR"
	INTEGER I, B ;
	FOR I ← LENGTH(DEFN!BRC)-LDEFN!BRC STEP -1 UNTIL 1 DO
		IF DEFN!BRC[I FOR 1] = CHR THEN
			BEGIN B ← I ; DONE END ;
	RETURN(B) ;
	END "FIND!CHR" ;
PUBLIC RECURSIVE PROCEDURE SCANTEXT ;$"#
BEGIN "SCANTEXT"
INTEGER N, CHR, F ;
BOOLEAN PLUS ;
STRING PIECE ;
LABEL ENDERLINE ;
TEXTMODE ← TRUE ; TES 8/23/74 ;
WHILE TEXTMODE DO
BEGIN
IF FULSTR(PIECE ← RD(TEXT!TBL)) THEN EMIT(PIECE) ;
IF BRC NEQ CR AND SIGNALD[BRC] AND SIGNA(BRC) THEN BEGIN COMMENT Responded to signal ; END
ELSE CASE CHARTBL[BRC] LAND '77 OF
BEGIN COMMENT BY BRC ;
COMMENT 0	; EMIT(BRC) ;
COMMENT 1 ... CR ;
	BEGIN SUPERSUB←HEIGHT←AMPPOSN←RIPTPOSNS←0 ;
	IF FILL AND CRSPACE THEN EMSPACES(IF SPCS OR  NOT POSN THEN 0 ELSE IF PUNC THEN 2 ELSE 1)
	ELSE IF IMPOSE THEN
		BEGIN "SUPERIMPOSE"
		IF (N ← SINCELFM+1) > TWEENLFM THEN DBREAK
		ELSE BEGIN EMIT(NULL); APPEND(CR & SPS(LMARG+(POSN←INDENT))); SINCELFM ← N ;
			TABI←MIDWORD←STARPOSN←FAKE←0 ; LBK←3; LBF←NULL; OKCR(FALSE) END ;
		END "SUPERIMPOSE"
	ELSE DBREAK ;
	TEXTMODE ← FALSE ;
	END ;
COMMENT 2 ... Altmode or { ;	TEXTMODE ← FALSE ;
COMMENT 3 ... Rubout;
	IF ON THEN
		BEGIN "LABEL REF"
		N ← CVD(SCAN(INPUTSTR,TO!VT!SKIP,F)) ;
		IF XCRIBL THEN
		    BEGIN
		    EMIT(S←"01234567890123456789012345678901234567890123456789"[1 FOR N]);
		    FAKE←FAKE+XLENGTH(S);
		    END
		 ELSE
		    BEGIN
		    EMIT(SPS(N)); FAKE←FAKE+N;
		    END;
		OAKS←OAKS-N;
		APPEND(VT&SCAN(INPUTSTR, TO!VT!SKIP, F)&ALTMODE) ;
		END "LABEL REF"
	ELSE FOR N ← 1,2 DO SCAN(INPUTSTR, TO!VT!SKIP, F) ;
COMMENT 4 ... α ;
	IF FULSTR(INPUTSTR) AND INPUTSTR NEQ ALTMODE THEN
		IF (N←LOP(INPUTSTR))=CR THEN TEXTMODE ← FALSE
		ELSE	IF XCRIBL THEN
		   		IF (F←LDB(SPCODE(N))) = XCMDCHR THEN
				  	BEGIN EMIT(N); APPEND(N) END
				ELSE EMIT(N)
			ELSE EMIT(N);
COMMENT 5 ... ↑C ; IF FILL THEN OKCR(FALSE) ELSE EMIT(BRC) ;
COMMENT 6 ... # ; EMIT(SP) ;
COMMENT 7 ... \ ;
	IF ON THEN
		BEGIN "NEXT TAB"
		POSN←POSN+SPCS; XPOSN←XPOSN+XSPLEN(SPCS); SPCS←0;
		DO BEGIN TABI←TABI+1; N←TABSORT[TABI] END
		    UNTIL N>TWO(15) OR (IF XCRIBL THEN N*CHARW>XPOSN ELSE N>POSN);
		IF N>TWO(15) THEN
			BEGIN TES 8/26/74 "ONLY"? ;
			WARN("BAD TAB", <IF N=TWO(33) THEN NULL
			    ELSE "TABBED PAST LAST TAB STOP">) ;
			TABI←TABI-1; N←POSN+2;
			END;
		TES 8/19/74 IF NO TAB SET, LEAVE A SPACE ;
		TABTO(N) ; IF N > NMAXIM+LMARG THEN TABI ← TABI - 1 ;
		END "NEXT TAB" ;
COMMENT 8 ... ∂ ;
	IF ENDOFSEGMENT THEN EMIT(BRC)
	ELSE
	BEGIN "SPECIFIC TAB"
	SPCS←0 ;
	CHR ← LOP(INPUTSTR) ;
	IF (PLUS ← CHR)="+" OR CHR="-" THEN CHR ← LOP(INPUTSTR) ELSE PLUS←0 ;
	IF CHR="(" THEN
		BEGIN
	        PASS ; N ← CVD(E("0",0)) ;
		IF  NOT ITSCH(<)>) THEN WARN("=",<"Missed ) after ∂(...">) ;
		END
	ELSE IF (F←LDB(FAMILY(CHR)))=0 THEN N←
		CVD( EVALV(SYM[N←SYMNUM(CAPITALIZE(CHR))],
		     LDB(IXN(N)), LDB(TYPEN(N)))) TES 8/19/74 FIX BUG ;
	ELSE IF F = DIGQ THEN N ← CHR - 48 comment, Digit ;
	ELSE BEGIN WARN("=","Unintelligible ∂ Construct") ; N ← 0 END ;
	IF PLUS="-" THEN
		BEGIN "BACKSPACE"
		EMIT(NULL) ; STARPOSN ← POSN MAX STARPOSN ;
		IF XCRIBL
			IFC PARCVER THENC TES 10/9/74 ;
				AND (ABS(DEVICE)=XGP OR N=1)
			ENDC
			 THEN
				BEGIN
				APPEND(FONTCHAR&'35&
				    (IF ENDOFSEGMENT THEN SP ELSE LOP(INPUTSTR)));
				IF N NEQ 1 THEN
				    WARN("=","Can't backspace more than one!!");
				END
			  ELSE
				BEGIN
				POSN ← POSN-N MAX 0 ;
				IFC PARCVER THENC TES 10/9/74 ;
				IF ABS(DEVICE)=MIC THEN
					XPOSN ← XPOSN-N*CHARW MAX 0 ;
				ENDC
				APPEND(FONTCHAR&PLUS&CVSR(N)) ;
				END;
		END
	ELSE IF PLUS="+" AND NULSTR(LBF) THEN
		BEGIN
		IF N>0 THEN
			BEGIN
			APPEND(FONTCHAR&"+"&CVSR(IF XCRIBL THEN N*CHARW ELSE N));
			POSN←POSN+N MIN NMAXIM+LMARG ;
			END;
		END
	ELSE TABTO((IF PLUS="*" THEN STARPOSN ELSE
		    IF PLUS="+" THEN POSN+N ELSE N) MIN NMAXIM+LMARG) ;
	END "SPECIFIC TAB" ;
COMMENT 9 ... ← ; IF LBK NEQ 2 THEN BOUND(1) ELSE EMIT(BRC) ;
COMMENT 10 ... → ; IF LBK NEQ 2 THEN BOUND(2) ELSE EMIT(BRC) ;
COMMENT 11 ... ∞ ; IF (N←INPUTSTR)=CR OR N=ALTMODE THEN WARN("=","∞ What?")
	      ELSE BOUND(-LOP(INPUTSTR)) ;
COMMENT 12 ... ↑ ;
	IF ON AND (CHR←INPUTSTR) NEQ CR AND CHR NEQ ALTMODE THEN SCRIPT("↑")
	ELSE EMIT(BRC) ;
COMMENT 13 ... ↓ ;
	IF ON THEN IF ENDOFSEGMENT THEN EMIT(BRC)
		ELSE IF LDB(SPCODE(INPUTSTR))=UNDERBAR THEN
		BEGIN
		LOPP(INPUTSTR) ;  EMIT(NULL) ;
		IF POSN LEQ MAXIM OR XCRIBL THEN
			BEGIN
			IF UNDERLINING=0 THEN APPEND(FONTCHAR&"_") ;
			UNDERLINING←2 ;
			END ;
		END
	ELSE SCRIPT("↓") ;
COMMENT 14 ... ] ; IF SUPERSUB AND ON THEN UNSCRIPT(0)
	           ELSE EMIT(BRC) ;
COMMENT 15 ... hyphen ;
	IF MIDWORD AND FILL AND ON AND NOT SUPERSUB THEN
		BEGIN
		EMIT("-") ; OKCR(FALSE) ;
		IF INPUTSTR=CR THEN
			BEGIN
			LOPP(INPUTSTR) ;
			TEXTMODE ← FALSE ;
			END ;
		END
	ELSE BEGIN N←MIDWORD ; EMIT(BRC) ; MIDWORD ← N END ;
COMMENT 16 ... .!? ;
	IF MIDWORD AND FILL AND ON AND NOT SUPERSUB THEN
		BEGIN
		EMIT(BRC) ;
		PUNC←TRUE ;
		END
	ELSE EMIT(BRC) ;
COMMENT 17 ... space ; EMSPACES(1 + LENGTH(RD(TO!NON!SP)) ) ;
COMMENT 18 ... underline ;
	IF LDB(SPCODE(INPUTSTR))=DARROW AND ON THEN
		BEGIN
		LOPP(INPUTSTR) ;  EMIT(NULL) ;
		IF UNDERLINING THEN
	ENDERLINE:	BEGIN
			UNDERLINING ← 0 ;
			IF POSN LEQ MAXIM OR XCRIBL THEN APPEND(FONTCHAR&"≡") ;
			END ;
		END
	ELSE	BEGIN COMMENT BARE UNDERLINE ;
		EMIT(NULL) ;
		IF POSN LEQ MAXIM OR XCRIBL THEN
			IFC PARCVER THENC TES 10/11/74 ;
			IF ABS(DEVICE)=MIC AND FULSTR(VUNDERLINE) THEN
				EMITPIECE(IF UNDERLINING THEN "_"
					ELSE FONTCHAR&"_"&VUNDERLINE&FONTCHAR&"≡",
					1, CW[SP])
			ELSE
			ENDC
			EMIT(IF NULSTR(VUNDERLINE) THEN " " ELSE VUNDERLINE) ;
		END ;
COMMENT 19 ... π ; TES 11/29/73 ;
	IF FULSTR(PIECE←PICHAR[CHR←INPUTSTR]) THEN
		BEGIN
		F ← LOP(PIECE) ; N ← LOP(PIECE) ;
		PIECE ← MASH(PIECE) ; TES 8/14/74 ;
		IF ON THEN
			COMMENT TES 1/12/75 CVSR: ;
		EMITPIECE(FONTCHAR & "π" & CVSR(LENGTH(PIECE)) & PIECE,
			IF XCRIBL OR F='177 THEN 1 ELSE 128*F+N, TES 9/26/74 ;
			IF NOT XCRIBL THEN 0
			ELSE IF F='177 THEN CW[N]
			ELSE 128*F+N) ;
		LOPP(INPUTSTR) ;
		END
	ELSE EMIT(BRC) ;
COMMENT 20 ... ∪ ;
	IF ON AND UNDERLINING=0 THEN
		BEGIN COMMENT ∪NDERLINE ONE WORD ;
		EMIT(NULL) ; UNDERLINING ← 1 ;
		IF POSN<MAXIM OR XCRIBL THEN APPEND(FONTCHAR & "_") ;
		IF FULSTR(PIECE←RD(ALPHA)) THEN EMIT(PIECE) ;
		GO TO ENDERLINE ;
		END ;
COMMENT 21 ... ∩ ; EMIT(BRC) ; COMMENT CURRENTLY NOT USED ;
COMMENT 22 ... VT ;
	WARN("=", <"Vertical tab found on a text line; either you typed <ctrl>K or" & CRLF &
	"you put a Horseshoe, )$, or ↑P (Template End) on a text line" & CRLF &
	"See Rule(1) on p.24 of manual">) ;
COMMENT 23 ... $ ; IF LDB(SPCODE(INPUTSTR))=LBRACK THEN
	BEGIN LOPP(INPUTSTR) ; TEXTMODE ← FALSE END ELSE EMIT(BRC) ; TES REM ERROR 6/11/74;
COMMENT 24 ... % ;
	IF ON THEN
		BEGIN "PERCENT"
		CHR←LOP(INPUTSTR);
		IF CHR="*" THEN F←OLDFONT
		ELSE IF (F ← RFONT(CHR)) < 0 THEN  TES 11/29/73 RFONT;
			BEGIN WARN("=","Illegal font '"&CHR&"'"); F←0 END;
		IF F>0 AND FNTFIL[F]=0 THEN
		    BEGIN
		    IF XCRIBL THEN  TES 11/5/73 ;
			    WARN("=","Unknown font '"&CHR&"'");
		    F←0;
		    END;
		IF F AND XCRIBL THEN
		    BEGIN
		    EMIT(NULL);
		    IF F NEQ THISFONT THEN APPEND(PICKFONT(F)) ;
		    SWITCHFONT(F) ; TES 11/15/73 SUBROUTINIZED ;
		    END;
		END;
COMMENT 25 ... ⊗ ; EMIT(BRC) ; comment PASS 3 control only, no action here ;
COMMENT 26 ... [ ; EMIT(BRC) ; comment just to be safe ;
COMMENT 27 ... & ; EMIT(BRC)   comment just to be safe ;
END ; COMMENT BY BRC ;
END ;
END "SCANTEXT" ;
PUBLIC SIMPLE PROCEDURE TURN(INTEGER CHR,FUN,ONOFF) ;$"#
BEGIN "TURN"
INTEGER CODE, X, M, STDCHR ; BOOLEAN HADCHR, DEFD ; LABEL FIN ;
DEFD ← FALSE ; CODE ← LDB(SPCODE(CHR)) ; STDCHR ← LDB(SPCHAR(FUN)) ;
IF CHR=TB THEN
	BEGIN
	DPB(TABTAB ← IF ONOFF THEN FUN ELSE 0, SPCODE(CHR)) ;
	GO TO FIN ;
	END
ELSE IF  NOT CODE THEN HADCHR ← FALSE
ELSE IF CODE=STDCHR AND ONOFF THEN GO TO FIN   COMMENT ALREADY ON ;
ELSE IF  NOT ONOFF OR  NOT STDCHR THEN
	BEGIN COMMENT REMOVE CHARACTER FROM BREAK TABLE STRING ;
	HADCHR ← TRUE ; X ← LENGTH(TEXT!BRC) ;
	START!CODE "FINDIT"
	LABEL NEXC, DUN ;
	MOVE 1, TEXT!BRC ; SKIPN 2, X ; JRST DUN ;
	NEXC: ILDB 3,1 ; CAMN 3, CHR ; JRST DUN ; SOJG 2, NEXC ;
	DUN: MOVEM 2, M ;
	END ;
	TEXT!BRC ← TEXT!BRC[1 TO X-M] & TEXT!BRC[X-M+2 TO X] ;
	END ;
IF ONOFF THEN
	BEGIN "ON" COMMENT REV. 2/20/73 TES ;
	IF STDCHR=XCMDCHR THEN DOPASS3←TRUE;  RKJ:  1-4-74;
	IF STDCHR AND STDCHR < LBRACK THEN TEXT!BRC ← TEXT!BRC & CHR ;
	IF FUN="{" AND  NOT FIND!CHR(CHR) THEN
		BEGIN
		DEFN!BRC ← CHR & DEFN!BRC ;
		DEFD ← TRUE ;
		END ;
	DPB(STDCHR, SPCODE(CHR)) ;
	END "ON"
ELSE	BEGIN "OFF"	 COMMENT REV. 2/20/73 TES ;
	INTEGER I ;
	IF FUN = "{" AND (I ← FIND!CHR(CHR)) THEN
		BEGIN
		DEFN!BRC ← DEFN!BRC[1 TO I-1] & DEFN!BRC[I+1 TO ∞] ;
		DEFD ← TRUE ;
		END ;
	IF HADCHR THEN DPB(0, SPCODE(CHR)) ;
	END "OFF" ;
SETBREAK(TEXT!TBL, TEXT!BRC&SIG!BRC, NULL, "IS") ;
IF DEFD THEN SETBREAK(DEFN!TABLE, DEFN!BRC, NULL, "IS") ;
FIN:
IF ONOFF LEQ 0 THEN ISTK[PUSHI(TURNWDS, TURNTYPE) - 1] ←
	CHR LSH 7 LOR (IF CHR=TB THEN CODE ELSE CHARSP[CODE FOR 1]) ;
END "TURN" ;
FINISHED

ENDOF("CTRLC")